home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Purity / Purity #22 (1994-01-19)(Diesel)(DE)[WB].zip / Purity #22 (1994-01-19)(Diesel)(DE)[WB].adf / PropGadTest / PropGadTest.p < prev    next >
Text File  |  1994-01-17  |  5KB  |  167 lines
  1. PROGRAM PropTest;
  2.  
  3. { *************************
  4.   ** ©1993 by BOMBERSOFT **
  5.   **                     **
  6.   **   G I F T W A R E   **
  7.   **                     **
  8.   ************************* }
  9.  
  10. {$OPT q}
  11.  
  12. USES Graphics;
  13. FROM MyTools USES ToolGad;
  14.  
  15. CONST
  16.   MaxTests = 25;
  17.   MaxShow  = 12;
  18.  
  19.   titel    = "PropGadTest V1.01 - GIFTWARE !";
  20.  
  21. TYPE
  22.   plane = ARRAY[1..5] OF WORD;
  23.   feld  = ARRAY[1..MaxTests] OF STRING;
  24.  
  25. VAR
  26.   wp                     : ^Window;
  27.   msg                    : ^IntuiMessage;
  28.   done                   : BOOLEAN;
  29.   KlickG                 : ^Gadget;
  30.   GadNum                 : CARDINAL;
  31.   pi                     : PropInfo;
  32.   g                      : ARRAY[1..3] OF Gadget;
  33.   img,img1,img2          : Image;
  34.   class,err,i,j,k        : LONG;
  35.   ds                     : feld;
  36.   bor                    : Border;
  37.   dat,dat1               : ^Plane;
  38.   rp                     : p_RastPort;
  39.  
  40. PROCEDURE Zeige;
  41. BEGIN
  42.   i:=Round(pi.VertPot/(MAXBODY/(MaxTests-(MaxShow))))+1;
  43.   k := 27;
  44.   FOR j := i TO i+11 DO
  45.   BEGIN
  46.     Move(rp,10,k);
  47.     err := _Text(rp,ds[j],Length(ds[j]));
  48.     k := k + 9;
  49.   END;
  50. END;
  51.  
  52. PROCEDURE abi;
  53. BEGIN
  54.   j:=Round(MAXPOT/MaxTests);
  55.   k:=pi.VertPot+Round(MAXBODY/(MaxTests-MaxShow));
  56.   IF k>MAXPOT THEN k:=MAXPOT;
  57.   pi.VertPot:=k;
  58.   RefreshGadget(wp,^g[1],NIL);
  59.   gbord(wp,^g[1]);
  60.   Zeige;
  61. END;
  62.  
  63. PROCEDURE aufi;
  64. BEGIN
  65.   j:=Round(MAXPOT/MaxTests);
  66.   k:=pi.VertPot-Round(MAXBODY/(MaxTests-MaxShow));
  67.   IF k<0 THEN k:=0;
  68.   pi.VertPot:=k;
  69.   RefreshGadget(wp,^g[1],NIL);
  70.   gbord(wp,^g[1]);
  71.   Zeige;
  72. END;
  73.  
  74. BEGIN
  75.   dat:=PTR(Alloc_Mem(SizeOf(Plane),2));
  76.   dat^:=Plane( %0000000110000000,
  77.                %0000001111000000,
  78.                %0000011111100000,
  79.                %0000111111110000,
  80.                %0001111111111000);
  81.   img1:=Image(1,2,16,5,1,dat,1,0,NIL);
  82.   dat1:=PTR(Alloc_Mem(SizeOf(Plane),2));
  83.   dat1^:=Plane(%0001111111111000,
  84.                %0000111111110000,
  85.                %0000011111100000,
  86.                %0000001111000000,
  87.                %0000000110000000);
  88.   img2:=Image(1,2,16,5,1,dat1,1,0,NIL);
  89.   ds:=feld("PropGadTest V1.01  (GIFTWARE)                ",
  90.            "                                             ",
  91.            "©1993 by Björn Schotte                       ",
  92.            "++++++++++++++++++++++                       ",
  93.            "                                             ",
  94.            "Mit den beiden Pfeil-Gadgets kannst Du       ",
  95.            "rauf oder runterblättern (jew. 1 Eintrag).   ",
  96.            "Schiebst Du jedoch das PropGadget, so        ",
  97.            "verschiebt sich der Text auch. Dies wird     ",
  98.            "durch das Flag FOLLOWMOUSE bewerkstelligt.   ",
  99.            "                                             ",
  100.            "Special Greetings fly to:                    ",
  101.            "                                             ",
  102.            "Steppenbrand/Diesel, Røgersøft, Perfect Soft,",
  103.            "und alle anderen, die ich vergessen hab !!   ",
  104.            "                                             ",
  105.            "                                             ",
  106.            "Ach ja, noch was:                            ",
  107.            "                                             ",
  108.            "Für das einzelne Verschieben des Textes per  ",
  109.            "Pfeilgadgets hab ich knapp 2 Stunden ge-     ",
  110.            "braucht (scheið®þ¤ PropInfo !!) !!           ",
  111.            "                                             ",
  112.            "                                             ",
  113.            "        ----      E  N  D  E      ----       ");
  114.  
  115.   wp:=Open_Window(0,0,410,135,1,_CLOSEWINDOW+GADGETUP+MOUSEMOVE,WINDOWCLOSE+
  116.   WINDOWDRAG+WINDOWDEPTH+SMART_REFRESH+NOCAREREFRESH+ACTIVATE,titel,NIL,0,0,0,0);
  117.   rp:=wp^.RPort;
  118.   SetDrMd(rp,JAM2);
  119.   SetAPen(rp,1);
  120.   pi:=PropInfo(AUTOKNOB+FREEVERT,0,0,0,Round(MAXBODY*(MaxShow/MaxTests)),
  121.   0,0,0,0,0,0);
  122.   g[1]:=Gadget(^g[2],380,18,18,95,0,FOLLOWMOUSE,PROPGADGET,^img,NIL,NIL,0,
  123.   ^pi,1,NIL);
  124.   g[2]:=Gadget(^g[3],
  125.                380,113,18,9,GADGIMAGE,RELVERIFY,BOOLGADGET,^img1,NIL,NIL,0,
  126.                NIL,2,NIL);
  127.   g[3]:=Gadget(NIL,
  128.                380,122,18,9,GADGIMAGE,RELVERIFY,BOOLGADGET,^img2,NIL,NIL,0,
  129.                NIL,3,NIL);
  130.   FOR i:=1 TO 3 DO err := AddGadget(wp,^g[i],0);
  131.   RefreshGadgets(wp^.FirstGadget,wp,NIL);
  132.   FOR i:=1 TO 3 DO gbord(wp,^g[i]);
  133.   umrandung(wp,2,1,6,18,374,113);
  134.   Zeige;
  135.   done:=FALSE;
  136.   REPEAT
  137.     msg:=p_IntuiMessage(WaitPort(wp^.UserPort));
  138.     msg:=p_IntuiMessage(GetMsg(wp^.UserPort));
  139.     class:=msg^.Class;
  140.     IF class=GADGETUP THEN
  141.     BEGIN
  142.       KlickG:=msg^.IAddress;
  143.       GadNum:=KlickG^.GadgetID;
  144.     END;
  145.     ReplyMsg(p_Message(msg));
  146.     CASE class OF
  147.       _CLOSEWINDOW : done:=TRUE;
  148.       GADGETUP:
  149.         CASE GadNum OF
  150.           2: aufi;
  151.           3: abi;
  152.         ELSE END;
  153.       MOUSEMOVE:
  154.         BEGIN
  155.           Zeige;
  156.         END;
  157.     ELSE END;
  158.   UNTIL done;
  159. END.
  160.  
  161.  
  162.  
  163.  
  164.  
  165.  
  166.  
  167.